00100	;Floppy disk file system.
00200	.INSERT ASMBL.FAI[CMS,LCS]
00300	   RETRY ← =10	;Number of retrys until error.
00400	   DMARK ← 74	;Directory mark
00500	   FMARK ← 72	;File mark
00600	   HMARK ← 67	;Hole mark?
00700	   LASTRK ← =34	;Last track
00800	   ZERO ← 274	;Fail offset
00900	   LOC ZERO
01000	
01100	CBLK:	0	;Ram command block.
01200	CCNT:	0	;C parameter count.
01300	CLEN:	0	;C # of sectors.
01400	CSEC:	0	;C sector
01500	CTRK:	0	;C track
01600		0
01700	FOTRK:	0	;Format track number.
01800		0
01900	FCMD:	0	;Disk command pointer.
02000	FCMDH:	0
02100	CMDJMP:	0	;Indirect command jump.
02200	CJMPH:	0	;Msbyte.
02300	ERFLG:	0	;Error flag/code.
02400	SVERR:	0	;Saved error.
02500	CEFLG:	0	;Communication error flag.
02600	RFOPEN:	0	;Read file open flag.
02700	WFOPEN:	0	;Write file open flag
02800	DIRC:	0	;Data direction
02900	FLEN:	0	;File length. In sectors.
03000	SREM:	0	;Sectors remaining.
03100	NTRYS:	0	;Number of retrys before error.
03200	BUSY:	0	;Busy flag
03300	MO:	0	;Motor on flag. MFLG = TL or TH?
03400	TL:	0	;Motor time out low.
03500	TH:	0	;Time out high.
03600	DIRCNT:	0	;Directory sector count
03700	HTRK:	0	;Hole track number
03800	HSEC:	0	;Hole sector number
03820	SVHY:	0	;Hole directory index.
03840	SVHSEC:	0	;Hole directory sector.
03900	FBLK:	0	;File block
04000	FNAME:	BLOCK 11	;9 Chr file name.
04100	NSEC:	0	;Number of sectors in file.
04200	FTRK:	0	;Disk track number
04300	FSEC:	0	;Disk sector number
04400		BLOCK 3
04500	DBLK:	0	;Directory block
04600	DSEC:	0	;Number of sectors in directory.
04700	FFDIR:	0	;First free directory block
04800	FFTRK:	0	;First free data track
04900	FFSEC:	0	;First free data sector
05000	FBLKS:	0	;Number of free sectors. In sectors.
05100	FBH:	0	;Msbyte
05200		0
05300	CKSUM:	0	;Check sum.
05400	SPOINT:	0	;SI/O pointer.
05500	SPOH:	0	;Msbyte
05600	DPOINT:	0	;Disk buffer bointer.
05700	DPOH:	0	;Msbyte
05800	   LOC ZERO+1000
05900	FBUF:	0	;Disk buffer
06000	   LOC FBUF + 400
06100	FBUF1:	0	;Other disk buffer.
     

00100	FCTBL:	LOC ZERO+174000	;PROM Start address.
00200	   DINIT ← 0
00300		65	;Specify
00400		4	;Parameter count.
00500		252	;H unload I cnt./ H load time.
00600		=25	;Head settling time in ms*2.
00700		=20	;Step rate in ms*2.
00800		15	;Init
00900	   SBT ← 6
01000		65	;Specify
01100		4
01200		0	;Current track.
01300		377
01400		377	;No bad tracks.
01500		20	;Surface zero bad tracks command.
01600	   DMA ← 14
01700		72	;Write special register.
01800		2
01900		0	;DMA and double actuator.
02000		27	;Mode register.
02100	   RESTOR ← 20
02200		151	;Seek track zero command.
02300		1	;With head load.
02400		0	;Track zero
02500	   MON ← 23
02600		72	;Write special register.
02700		2	;Clear out pins.
02800		40	;Optional output / motor on bit.
02900		43	;Drive control output register.
03000	   MOFF ← 27
03100		72	;Write special register.
03200		2	;Clear out pins.
03300		0	;Optional output / motor off.
03400		43	;Drive control output register.
03500	   RHDR0 ← 33
03600	RH0:	123	;Read two sectors command.
03700		3
03800		2	;# of sectors.
03900		1	;Header sector number
04000		0	;Header track number
04100	   WHDR0 ← 40
04200	WH0:	113	;Write two sectors command.
04300		3
04400		2	;# of sectors.
04500		1	;Header sector number.
04600		0	;Header track number.
04700	    RDSTAT ← 45
04800		154	;Read drive status command.
04900		0
05000	ID0:	113	;Write two sectors.
05100		3
05200		=16	;# of sectors.
05300		1	;First sector.
05400		0	;Track zero.
05500	FORMT:	143	;Format track command.
05600		5
05700		=16	;Gap 1 -6.
05800		0	;Gap 5. No index mark.
05900		=16	;Sectors per track.
06000		=27	;Gap 3 -6.
06100		0	;Format track number.
     

00100	;Add deselect?
00150	;Add surface 1 bad tracks?
00200	;Restore bug in 8271?
00300	;Add restore to retry?
00400	;COMERRs ?  In ACK?
00500	;Add write protect and not ready error codes.
00600	;Flush other dir. = LASTRK?
00700	
00800	;Power on reset.
00900	RST:	LDXI	377	;Setup stack.
01000		TXS
01100		CLD	;Clear decimal mode.
01200	
01300	;Reset I/O
01400	   SIOC  ← 20000	;SI/O command register.
01500	   SIOD  ← 20001	;SI/O data register.
01600	   FDSKC ← 10000	;Disk command/status register
01700	   FDSKP ← 10001	;Disk parameter/result register
01800	   FDSKR ← 10002	;Disk reset register.
01900	   FDRQ  ← 14000	;Disk DMA data request
02000	
02100	;Init floppy disk controller.
02200		LDAI	1	;Reset disk again.
02300	;	STA	FDSKR
02400		LSRA	;Clear A
02500	;	STA	FDSKR
02600	
02700		LDAI	DINIT	;Disk initialization command.
02800		JSR	PCMD	;Prom command.
02900		LDAI	DMA	;Setup DMA mode.
03000		JSR	PCMD
03100	
03200		LDAI	RESTOR	;Restore track zero.
03300		JSR	PCMD	;Add delay? Read sp. reg?
03400	
03500		LDAI	SBT	;Setup bad tracks
03600		JSR	PCMD
03700		LDA	FDSKP	;Read result reg. to clr int.?
03800				;Or add to PCMD?
03900	;Reset SI/O
04000		LDAI	3	;Reset bits
04100		STA	SIOC
04200		LDAI	25	;ACIA control word.
04300		STA	SIOC
04400	
04500	;Init RAM
04600		LDAZ	DSEC
04700		STAZ	DIRCNT	;Point to end of directory.
04800		STAZ	MO	;Init motor flag.
04900		CLI	;Enable interrupts?
     

00100	IDLSET:	LDAI	0
00200		STAZ	RFOPEN	;Reset read file open flag.
00300		STAZ	WFOPEN	;Clear write file open flag.
00400	
00500		STAZ	CEFLG	;Clear comm. error flag.
00600		STAZ	ERFLG	;Clear error flag.
00700		STAZ	SVERR	;Clear other error flag.
00800	
00900		STAZ	DIRC	;Set disk to read.
01000		STAZ	BUSY	;Set to not busy.
01100		TAX	;Start lsbyte of motor time out.
01200	
01300	   TWOS ← 3	;3 = 1.77s, 4 = 2.3s.
01400	;	JSR	IDLEW	?
01500	IDLE:	BITZ	MO	;Check if motor on.
01600		BPL	GSOH
01700		LDA	SIOC	;Read SI/O status.
01800		LSRA	;Get rcvr. full bit.
01900		BCS	GSOH
02000	
02100		DEX	;Time out countdown.
02200		BNE	IDLE
02300		DECZ	TL
02400		BNE	IDLE
02500		DECZ	TH
02600		BNE	IDLE
02700		JSR	MOTOFF	;Turn off motor.
02800	   ;Check for file open??
02900	;	JMP	IDLSET	?
03000	
03100	GSOH:	JSR	GCHR	;Wait for SOH.
03200		CMPI	1	;<SOH>.
03300		BNE	ILLCMD	;Error.
03400		JSR	GCHR	;Wait for command.
     

00100	DCODE:	LDXI	NCMDS	;# of commands.
00200	DL:	CMPX	CMDTBL	;Check if valid command.
00300		BEQ	JCMD
00400		DEX
00500		BPL	DL
00600	;Illegal command.
00700	ILLCMD:	LDXI	4	;Command error code.
00800	OCLR:	JSR	OCHR	;Output status.
00900		JMP	IDLSET	;Reset flags.
01000	
01100	JCMD:	LDAX	JLTBL	;Get lsbyte of jump address.
01200		STAZ	CMDJMP
01300		LDAX	JHTBL	;Get msbyte.
01400		STAZ	CJMPH
01500	
01600		JMPIN	CMDJMP	;Excute command.
01700	   ;Fix JMPIN in ASMBL.FAI.
01800	
01900	   NCMDS ← =9	;# of commands -1.
02000	;Swap order for faster DECODE?
02100	CMDTBL:	"W"	;Write data
02200		"R"	;Read data
02300		"E"	;Enter write file.
02400		"C"	;Close write file.
02500		"O"	;Open read file.
02600		"K"	;Delete file.
02700		"D"	;Open directory.
02800		"N"	;Next directory block.
02900		"B"	;Free blocks
03000		"P"	;Perform special function.
03100	
03200	;Check all funny addresses.
03300	JLTBL:	WRITE∧377	;Lsbyte of command address.
03400		READ∧377
03500		ENTR∧377
03600		CLOZE∧377
03700		OPIN∧377
03800		KIL∧377
03900		DIR∧377
04000		NXTDIR∧377
04100		BLKS∧377
04200		PSF∧377
04300	
04400	JHTBL:	WRITE⊗-10	;Msbyte of command address.
04500		READ⊗-10
04600		ENTR⊗-10
04700		CLOZE⊗-10
04800		OPIN⊗-10
04900		KIL⊗-10
05000		DIR⊗-10
05100		NXTDIR⊗-10
05200		BLKS⊗-10
05300		PSF⊗-10
     

00100	;Write command to FDSKC. No wait or * NTRYS.
00200	PCMD:	STAZ	FCMD	;Prom command with no retrys.
00300		LDAI	370	;Msbyte of command table addr.
00400		STAZ	FCMDH
00500		LDAI	0
00600		STAZ	NTRYS
00700		BEQ	WCMD	;Jump.
00800	
00900	RCMD:	LDAI	0	;Ram command with no retrys.
01000		STAZ	NTRYS
01100	TRY:	LDAI	0
01200		STAZ	FCMD
01300		STAZ	FCMDH
01400	
01500	WCMD:	LDAI	377	;Set busy.
01600		STAZ	BUSY	;?
01700		LDAI	0
01800		STAZ	DPOINT	;Reset disk DMA pointer.
01900	
02000	BSYW:	LDA	FDSKC	;Wait until not busy.
02100		BMI	BSYW
02120		ANDI	100	;Command full bit.
02140		BNE	BSYW	;Wait until cmd. reg. empty.
02200	
02300		LDYI	0
02400		LDAIY	FCMD	;Get command code.
02500		STA	FDSKC	;Write in disk control reg.
02600	
02700		INCZ	FCMD	;Point to parameter count.
02800		LDAIY	FCMD	;Get count.
02900		BEQ	NOPAR	;If no parameters
03000		TAY
03020	
03040	FULLW:	LDA	FDSKC	;Read disk status.
03060		ANDI	100	;Command full bit.
03080		BNE	FULLW	;Wait until empty?
03100	
03200	PARW:	LDA	FDSKC	;Read status
03300		ANDI	40	;P reg full bit.
03400		BNE	PARW	;Wait if still full.
03500	
03600		LDAIY	FCMD	;Parameter
03700		STA	FDSKP
03800		DEY
03900		BNE	PARW	;More left?
04000	
04100	NOPAR:	RTS
04200	
04300	;Disk command with retrys on read error.
04400	RCMDR:	LDAI	RETRY
04500		STAZ	NTRYS
04600		JSR	TRY	;RAM disk command.
04700		RTS
04800	
04900	RCMDW:	JSR	RCMDR	;Read command wait.
05000	BW:	BITZ	BUSY
05100		BMI	BW	;Wait until done
05200		LDAZ	ERFLG	;Get error bits.
05300		RTS	;Return with error bits.
     

00100	;IRQ maskable interrupt routines.
00200	IRQV:	PHA	;Save Registers.
00300		TYA
00400		PHA
00500	
00600	   ;Wait for result bit?
00700		LDA	FDSKP	;Read disk result register.
00800		ANDI	36	;Flush ddbit
00900		STAZ	ERFLG
01000		BNE	DSKERR	;Disk error.
01100		BITZ	DIRC	;Check if write.
01200		BPL	NOTBSY	;No errors.
01300		LDAI	0
01400		STAZ	DIRC	;Not write.
01500		LDAZ	CBLK
01600		CMPI	143	;Check if format command.
01700		BEQ	NOTBSY
01800	
01900		LDAI	137	;Disk verify command.
02000		STAZ	CBLK
02100		JSR	WCMD	;Verify write.
02200	
02300		JMP	RTRN	;Wait until done.
02400	
02500	DSKERR:	ANDI	20	;Bad bit
02600		BEQ	CKTRY
02700	;Dsk error: RDY,WRT fault, etc.
02800		STAZ	SVERR	;Save bad error.
02900		LDAI	RDSTAT	;Read dirve status.
03000		JSR	PCMD	;No interrupt.
03100	;Put error routine someplace else?
03200	;20 Not ready.
03300	;21 Write protect.
03400	;22 Restore error.
03500	;23 File not found.
03600	;30 Sector not found.
03700	;Read drive status if not ready for clear.
03900		JMP	NOTBSY
04000	
04100	CKTRY:	LDAZ	NTRYS
04200		BEQ	NOTBSY
04300		
04400		DECZ	NTRYS
04500		JSR	WCMD	;Retry command.
04600		JMP	RTRN	;Wait until done.
04700	
04800	NOTBSY:	LDAI	0
04900		STAZ	BUSY	;Set done
05000		STAZ	DIRC	;Reset to read.
05100	
05200	RTRN:	PLA	;Restore Registers.
05300		TAY
05400		PLA
05500		RTI	;Return
     

00100	;Non-maskable DRQ interrupt.
00200	NMIV:	PHA	;Save registers
00300		TYA
00400		PHA
00500		LDYI	0	;No index.
00600	
00700		BITZ	DIRC	;Get direction.
00800		BMI	WDRQ	;Disk write.
00900	
01000		LDA	FDRQ	;Read byte from disk.
01100	
01200		STAIY	DPOINT	;Save it in FBUF
01300		JMP	INCPO	;Increment disk buffer pointer.
01400	
01500	WDRQ:	LDAIY	DPOINT	;Get byte from FBUF.
01600		STA	FDRQ	;Write in disk data register.
01700	
01800	INCPO:	INCZ	DPOINT
01900	
02000		PLA	;Restore registers.
02100		TAY
02200		PLA
02300		RTI	;Return
     

00100	;Directory look up.
00200	;Returns with file found, fnf, or read error.(0,200,XX)
00300	LOKUP:	LDXI	0
00400	GNAME:	JSR	GCHR	;Get name.
00500		STAZX	FNAME
00600		INX
00700		CPXI	=10	;9 Chr file name + EOT.
00800		BCC	GNAME
00900	
01000		CMPI	4	;EOT
01100		BEQ	GHD
01200		PLA	;One level pop to ILLCMD.
01300		PLA
01400		JMP	ILLCMD
01500	
01600	GHD:	JSR	RHDR	;Read directory header sector.
01700		BNE	LUERR
02000		LDAI	FMARK
02100		STAZ	FBLK
02200	
02300	GETS:	JSR	RNDS	;Read next 2 directory sectors.
02400		BNE	LUERR
02500		LDYI	0
02600	CKDIR:	LDXI	0
02700	CKNAM:	LDAY	FBUF
02800		CMPZX	FBLK	;Look for file name.
02900		BNE	NXTF	;No match
03000		INY
03100		INX
03200		CPXI	=11	;9 chrs. + fmark + 1.
03300		BCC	CKNAM
03400	;Names match
03500	FMOV:	LDAY	FBUF	;Save file record.
03600		STAZX	FBLK
03700		INY
03800		INX
03900		CPXI	20
04000		BCC	FMOV
04100	
04200		LDAI	0	;Return with file found.
04300	LUERR:	RTS	;Return with error bits.
04400	
04500	NXTF:	TYA	;Point to next file record.
04600		ORAI	17
04700		TAY
04800		INY
04900		BNE	CKDIR
05000	
05100		DECZ	SREM	;Check if more sectors.
05200		DECZ	SREM
05300		BNE	GETS
05400		LDAI	200	;Return file not found code.
05500		RTS
     

00100	;Read 1st sec of a directory. Returns with 0 or Ebits.
00200	RHDR:	JSR	MOTON	;Turn on motor and delay.
00300		LDXI	4
00400	CSET:	LDAX	RH0	;Setup command list.
00500		STAZX	CBLK
00600		DEX
00700		BPL	CSET
00800	
00900		JSR	SETDPO	;Point disk to FBUF.
01000		JSR	RSEC	;Read it * 16.
01100		BNE	HERR
01200		LDA	FBUF
01300		CMPI	DMARK	;Check for directory.
01400		BNE	HERR
01500	
01600	GHDR:	LDXI	7
01700	GHL:	LDAX	FBUF
01800		STAZX	DBLK
01900		DEX
02000		BPL	GHL
02100		LDAZ	DSEC
02150		STAZ	SREM	;Number of sectors in dir.
02200		STAZ	DIRCNT	;Reset directory count.
02300		LDAI	0	;No error return
02400	HERR:	RTS	;Return with error bits.
02500	
02600	;Read next dir. sector. Returns with error bits.
02700	RNDS:	INCZ	CSEC	;Read next dir sec.
02800		INCZ	CSEC
02900	RSEC:	JSR	RCMDW	;Disk command wait * RETRYS
03000		BEQ	GOTIT	;Good read
03100		LDAI	LASTRK	;Last track
03200		STAZ	CTRK
03300		JSR	RCMDW
03400		LDAI	0	;Fix CTRK for next read.
03500		STAZ	CTRK
03600		LDAZ	ERFLG	;Get error bits.
03700	GOTIT:	RTS	;Return with error bits.
03800	
03900	SETDPO:	LDAI	0	;Point disk to FBUF
04000		STAZ	DPOINT
04100		LDAI	FBUF⊗-10
04200		STAZ	DPOH
04300		RTS
     

00100	;Open read file.
00200	OPIN:	BITZ	WFOPEN	;Check if write file open.
00300		BPL	LOOK
00400		JMP	FAO	;File already open error.
00500	
00600	LOOK:	JSR	LOKUP	;Lookup file FNAM
00700		BEQ	SETOPN
00800		CMPI	200	;File not found code.
00900		BEQ	NACKIT
01000		JMP	DIRERR	;Directory read error
01100	NACKIT:	JMP	FNF	;File not found.
01200	
01300	SETOPN:	LDAZ	FTRK	;Get track and sector
01400		STAZ	CTRK
01500		LDAZ	FSEC
01600		STAZ	CSEC
01700		LDAZ	NSEC	;Get file length.
01800		STAZ	SREM
01900	;Fill FBUF
02000		JSR	RCMDR	;* NTRYS and no wait.
02100	
02200		JSR	SETSPO	;Point SPOINT to FBUF.
02300		LDAI	377
02400		STAZ	RFOPEN
02500	
02600	ACK:	LDXI	6	;<ack>
02700	OACK:	JSR	OCHR	;Output byte.
02800		JSR	SPIN
02900		JMP	IDLE	;No flag clear.
03000	
03100	SETSPO:	LDAI	0	;Reset SI/O pointer.
03200		STAZ	SPOINT
03300		LDAI	FBUF⊗-10
03400		STAZ	SPOH
03500		RTS
     

00100	;Read a block of the file.
00200	READ:	JSR	GEOT	;Wait for EOT.
00300		BITZ	RFOPEN	;Check if file open.
00400		BMI	CKS
00500		JMP	FNF	;File not found
00600	CKS:	LDAZ	SREM	;Check for end of file.
00700		BNE	READO	;For FLEN = 0.
00800	EOF:	LDXI	6	;End of file error code.
00900		JMP	OCLR	;Output X and clear flags.
01000	
01100	READO:	LDAI	0	;Init check sum.
01200		STAZ	CKSUM
01300	RW:	BITZ	BUSY	;Wait until not busy.
01400		BMI	RW
01500		LDAZ	ERFLG	;Check for *16 read error.
01600		BEQ	NXTBUF
01700	   ;Output 256 zeros?
01800	DRERR:	LDXI	11	;Disk read error.
01900		JMP	OCLR
02000	
02100	NXTBUF:	DECZ	SREM	;Check if end of file.
02200		DECZ	SREM
02300		BEQ	ACKIT
02400	   ;Start read of next buffer.
02500		INCZ	CSEC	;Next sector.
02600		INCZ	CSEC
02700		LDAZ	CSEC	;Check if next track.
02800		CMPI	=16
02900		BCC	RNS
03000		LDAI	1	;First sector.
03100		STAZ	CSEC
03200		INCZ	CTRK	;Next track.
03300	
03400	RNS:	JSR	SWDBUF	;Swap disk buffers.
03500		JSR	RCMDR	;No wait.
03600	
03700	ACKIT:	JSR	PACK	;Output <ack>.
03800		JSR	PSTX	;Output <stx>.
03900	
04000		LDYI	0
04100	RDIT:	LDAIY	SPOINT	;Output a buffer full.
04200		TAX
04300		JSR	OCHR
04400		TXA
04500		CLC
04600		ADCZ	CKSUM
04700		STAZ	CKSUM
04800		INY
04900		BNE	RDIT
05000	
05100		JSR	SWSBUF	;Swap SI/O buffers.
05200		LDAZ	CKSUM	;Output check sum.
05300		EORI	377
05400		TAX
05500		INX
05600		JMP	OACK	;Output it and no flag clear.
05700	
05800	SWSBUF:	LDAZ	SPOH
05900		EORI	1	;Swap SI/O buffers.
06000		STAZ	SPOH
06100		RTS
     

00100	;Create file routine
00200	ENTR:	BITZ	WFOPEN	;Check if file already open
00300		BPL	CKRFO
00400	FAO:	LDXI	=8	;File already open error.
00500		JMP	OACK	;Output it.
00600	CKRFO:	BITZ	RFOPEN	;Check if read file open.
00700		BPL	LOKIT
00800		LDAI	0
00900		STAZ	RFOPEN	;Close read file?
01000	LOKIT:	JSR	LOKUP	;Check if file already exists.
01100		BEQ	FEXIST	;Check if file exists
01200		CMPI	200	;Not in dir. code
01300		BEQ	FULCK
01400	DIRERR:	LDXI	10	;Directory read error code.
01500		JMP	OCLR	;Clear flags.
01600	
01700	FEXIST:	LDXI	2	;File exists error code.
01800		JMP	OCLR	;Clear flags.
01900	
02000	FULCK:	LDAZ	FFTRK	;Get first free track.
02100		CMPI	LASTRK	;Check if disk full.
02200		BCC	GFBLK
02300	DSKFUL:	LDAI	LASTRK	;Set full flag.
02400		STAZ	FFTRK	;Check close?
02500		LDXI	5	;Disk full.
02600		JMP	OCLR	;Output X and clear flags.
02700	
02800	GFBLK:	STAZ	CTRK	;Point to new file.
02900		STAZ	FTRK	;Setup file block.
03000		STAZ	CLEN	;Track number for seek.
03100		LDAI	151	;Seek track command.
03200		STAZ	CBLK
03300		LDAI	1
03400		STAZ	CCNT
03500	
03600		JSR	RCMD	;Seek track.
03700	
03800		LDAI	3	;Setup command parameter count.
03900		STAZ	CCNT
04000		STAZ	DPOH	;Point disk to other buffer.
04100		LDAI	2	;Setup number of sectors.
04200		STAZ	CLEN
04300		LDXZ	FFSEC
04400		STAZ	FSEC	;Setup file block.
04500		DEX	;-1 For inc. before write.
04600		DEX
04700		STXZ	CSEC
04800	
04900		JSR	SETSPO	;Point SI/O to FBUF.
05000		LDAI	0
05100		STAZ	FLEN	;Reset file length.
05200	
05300		LDAI	377	;Set write file open flag.
05400		STAZ	WFOPEN
05500		JMP	ACK	;Return with no errors
     

00100	;Write file.
00200	;Fix full check for write last sector?
00300	WRITE:	JSR	GEOT	;Wait for EOT.
00400		BITZ	WFOPEN	;Check if file open.
00500		BMI	WIT
00600		JMP	FNF	;File not found
00700	WIT:	LDAZ	FFTRK
00800		CMPI	LASTRK	;Check if disk is full.
00900		BCC	DSKFUL
01000	
01100		LDAI	0
01200		STAZ	CKSUM	;Init check sum.
01300	
01400		JSR	PACK	;Output <ACK>.
01500		JSR	GCHR	;Wait for STX.
01600		CMPI	2	;<STX>.
01700		BNE	COMERR	;No STX.
01800	
01900		LDYI	0
02000	WLOOP:	JSR	GCHR	;Fill FBUF.
02100		STAIY	SPOINT
02200		CLC
02300		ADCZ	CKSUM	;Update check sum.
02400		STAZ	CKSUM
02500		INY
02600		BNE	WLOOP
02700	
02800		JSR	GCHR	;Get check sum.
02900		CLC
03000		ADCZ	CKSUM	;Check for check sum error.
03100		BEQ	WBUF
03200	COMERR:	LDXI	=9	;Communication error.
03300		JMP	OCLR	;Reset flags.
03400	
03500	WBUF:	BITZ	BUSY	;Wait until last buffer done.
03600		BMI	WBUF
03700		LDAZ	ERFLG	;Check for errors.
03800		BEQ	NFBLK
03900		JMP	DRERR	;Write error.
04000	NFBLK:	INCZ	CSEC	;Fix sector number.
04100		INCZ	CSEC
04200		LDAZ	CSEC
04300		CMPI	=16	;Check if end of track.
04400		BCC	SWBUF
04500		LDAI	1	;First sector.
04600		STAZ	CSEC
04700		INCZ	CTRK	;Next track.
04800		LDAZ	CTRK
04900		CMPI	LASTRK	;Check if disk full?
05000		BCC	SWBUF
05100		JMP	DSKFUL
     

00100	SWBUF:	JSR	SWDBUF	;Swap disk buffers.
00200		JSR	WBUFR	;Write buffer.
00300		
00400		JSR	SWSBUF	;Swap SI/O buffers.
00500		INCZ	FLEN	;Update file length.
00600		INCZ	FLEN
00700		JMP	ACK	;No error return.
00800	
00900	WBUFR:	LDAI	113	;Write two sectors command.
01000		STAZ	CBLK
01100	WUF:	LDAI	377
01200		STAZ	DIRC	;Set to write.
01300		JSR	RCMDR	;* NTRYS.
01400		RTS
01500	
01600	WBUFW:	JSR	WBUFR	;Write it.
01700	WW:	BITZ	BUSY
01800		BMI	WW	;Wait until not busy.
01900		LDAZ	ERFLG
02000		RTS
02100	
02200	SWDBUF:	LDAZ	DPOH
02300		EORI	1	;Swap disk buffers.
02400		STAZ	DPOH
02500		RTS
     

00100	CLOZE:	JSR	GEOT	;Wait for EOT.
00200		BITZ	WFOPEN	;Check if file open
00300		BMI	UPDIR
00400		JMP	FNF	;File not found.
00500	
00600	;Update directory
00700	UPDIR:	LDAZ	FLEN
00800		STAZ	NSEC
00900	
01000	CLZ:	BITZ	BUSY	;Wait until not busy.
01100		BMI	CLZ
01200		LDAZ	ERFLG	;Check for error.
01300		BEQ	BUMP
01400		JMP	DRERR	;Last buffer write error?
01500	
01600	BUMP:	LDAZ	FFTRK	;Save new FFTRK.
01700		STAZ	HTRK
01800		INCZ	CSEC	;Point to next free data block.
01900		INCZ	CSEC
02000		LDAZ	CSEC
02100		CMPI	=16	;Number of secs. per track +1.
02200		BCC	FIXFF
02300		INCZ	HTRK	;Next track.
02400		LDAI	1	;First sector.
02500	FIXFF:	STAZ	HSEC	;Save new FFSEC.
02600	
02700	;Read directory header and last directory sector.
02800		JSR	RHDR	;Read dir. header
02900		BNE	RDE	;Dir. read error.
03000		LDXZ	DSEC	;Last directory sector -1.
03100		INX	;Bump.
03200		STXZ	CSEC
03300		STXZ	SREM	;Save last dir. sec. number.
03400		JSR	SWDBUF	;Swap bufs.for last dir. save.
03500		JSR	RNDS	;Read next dir. sec.
03600		BEQ	CLOZIT
03700	RDE:	JMP	DIRERR	;Directory read error.
03800	
03900	CLOZIT:	LDYZ	FFDIR
04000	
04100		LDXI	0	;BLT FBLK into directory
04200	NAMEIT:	LDAZX	FBLK
04300		STAY	FBUF1	;Other buffer.
04400		INY
04500		INX
04600		CPXI	10	;FBLK Length
04700		BCC	NAMEIT
04800	
04900		JSR	WBUFW	;Write directory 0.
     

00100	;Update directory header.
00200	WRTH0:	CLC
00300		LDAZ	FFDIR
00400		ADCI	20	;Update end of dir.
00500		STAZ	FFDIR
00600		BNE	UPFF
00700		INCZ	DSEC	;Next sector
00800		INCZ	DSEC
00900		LDAZ	DSEC	;Check if directory full.
01000		CMPI	=15	;?
01100		BCC	UPFF
01200		LDAI	=14	;?
01300		STAZ	DSEC
01400		LDAI	LASTRK	;Set disk full.
01500		STAZ	FFTRK
01600	UPFF:	LDAZ	HSEC	;Point to next free block.
01700		STAZ	FFSEC
01800		LDAZ	HTRK
01900		STAZ	FFTRK
02000		SEC
02100		LDAZ	FBLKS
02200		SBCZ	FLEN	;Update free blocks.
02300		STAZ	FBLKS
02400		BCS	SVSEC
02500		DECZ	FBH
02600	
02700	SVSEC:	LDXI	7	;Header length
02800	HLOOP:	LDAZX	DBLK	;BLT Header into directory
02900		STAX	FBUF
03000		DEX
03100		BPL	HLOOP
03200	
03300		LDAI	1	;First sector.
03400		STAZ	CSEC
03500		JSR	SWDBUF	;Swap disk buffers.
03600	
03700		JSR	WBUFW	;Write dir. header 0.
03800		LDAI	LASTRK	;Last track
03900		STAZ	CTRK
04000		JSR	WBUFW	;Write dir. header 1.
04100	   ;Write last track directory.
04200		LDAZ	SREM	;Get last dir.sec. number.
04300		STAZ	CSEC
04400		JSR	SWDBUF	;Swap buffers.
04500		JSR	WBUFW
04600		BNE	CLZERR
04700	
04800		LDAZ	SVERR
04900		BEQ	CLOZD
05000	   ;Close error.
05100	CLZERR:	JMP	DIRERR	;?
05200	CLOZD:	STAZ	WFOPEN	;Reset write file open flag.
05300		JMP	ACK
     

00100	PSF:	JSR	GEOT
00200		JSR	PACK	;<Ack>
00300		JSR	GCHR	;Wait for SOH.
00400		CMPI	1	;SOH
00500		BNE	PSFERR
00600		JSR	GCHR	;Wait for special function cmd.
00700		CMPI	"Q"	;Compress holes.
00800		BNE	CKF
00900		JSR	GEOT	;Wait for EOT.
01000		JMP	CMPRES
01100	
01200	CKF:	CMPI	"F"	;Format disk.
01300		BNE	CKI
01400		JMP	FORM
01500	CKI:	CMPI	"I"	;Initialize directory.
01600		BEQ	IDIR
01700	PSFERR:	JMP	ILLCMD	;Command error.
01800	;Initialize directory.
01900	IDIR:	JSR	GEOT	;Wait for EOT.
02000		JSR	MOTON	;Turn on motor.
02100		LDXI	10
02200		LDAI	0
02300	ZE:	STAX	FBUF	;Zero directory
02400		INX
02500		BNE	ZE
02600		LDXI	7
02700	DIIL:	LDAX	DIT	;Init dir.
02800		STAX	FBUF
02900		DEX
03000		BPL	DIIL
03100	
03200		LDXI	4
03300	SETC:	LDAX	ID0	;Setup CBLK.
03400		STAZX	CBLK
03500		DEX
03600		BPL	SETC
03700	
03800		JSR	SETDPO
03900		JSR	WBUFW	;Write first header and dir.
04000		LDAI	1
04100		STAZ	CSEC	;First sector.
04200		LDAI	LASTRK	;Last track.
04300		STAZ	CTRK
04400		JSR	WBUFW	;Init last directory.
04500	
04600		BEQ	OK	;Check for errors.
04700		LDAZ	SVERR
04800		BNE	IDERR
04900	OK:	JMP	ACK
05000	IDERR:	LDXI	7	;Init dir. error.
05100		JMP	OCLR	;Reset flags.
05200	
05300	DIT:	DMARK
05400		2	;# of sectors
05500		0	;FFDB
05600		1	;FFT
05700		1	;FFS
05800		=264∧377	;FBL?
05900		1	;FBH
06000		0
     

00100	;Delete file.
00200	KIL:	JSR	LOKUP
00300		BEQ	KILIT
00400	FNF:	LDXI	3	;File not found.
00500		JMP	OCLR
00600	KILIT:	LDAI	HMARK
00700		STAY	760	;FBUF - 20
00800		JSR	WBUFW	;Write and wait.
00900		BNE	JDER
01000		LDAI	LASTRK
01100		STAZ	CTRK
01200		JSR	WBUFW	;Write last dir. track.
01300		BEQ	JACK	;No errors.
01400	JDER:	JMP	DIRERR	;Error.
01500	
01600	DIR:	JSR	GEOT	;Wait for EOT.
01700		JSR	RHDR	;Read header.
01800		BNE	JDER
01900		LDAI	0	;Point to start
02000		STAZ	DIRCNT
02100	JACK:	JMP	ACK
02200	
02300	NXTDIR:	JSR	GEOT	;Wait for EOT.
02400		LDXZ	DIRCNT	;Check if at end.
02500		CPXZ	DSEC	;Check if done.
02600		BCC	NXD
02700		JMP	EOF
02800	
02900	NXD:	INX	;Bump past header.
03000		INX
03100		STXZ	DIRCNT	;Update directory count.
03200		JSR	PACK	;Output <ACK>.
03300	
03400		JSR	RNDS	;Read next directory sector.
03500		BNE	JDER
03600	
03700		JSR	PSTX	;Output <STX>.
03800		LDYI	0
03900	DOL:	LDAY	FBUF	;Find file in FBUF.
04000		CMPI	FMARK
04100		BNE	NXBLK
04200	
04300		LDAI	=10	;9 Chr file name + # of secs.
04400		STAZ	HSEC
04500		LDXI	":"
04600	FBOUT:	JSR	OCHR	;Output it.
04700		INY
04800		LDXY	FBUF	;Get FBLK.
04900		DECZ	HSEC
05000		BPL	FBOUT
05100	
05200	NXBLK:	TYA
05300		ORAI	17	;Next file block.
05400		TAY
05500		INY
05600		BNE	DOL
05700	
05800		BEQ	OEOT	;Jump.
     

00100	;Output free blocks.
00200	BLKS:	JSR	GEOT	;Wait for EOT.
00300		JSR	RHDR	;Read directory header.
00400		BNE	DJ	;Directory read error.
00500		JSR	PACK	;<ack>
00600		JSR	PSTX	;Output STX.
00700		LDXZ	FBLKS
00800		JSR	OCHR
00900		LDXZ	FBH
01000		JSR	OCHR
01100	OEOT:	LDXI	4	;<EOT>.
01200		JMP	OCLR	;Clear flags.
01300	;Compress holes.
01400	CMPRES:	JSR	RHDR	;Read directory header.
01500		BNE	DJ
01600	SQEZ:	JSR	RNDS
01700		BNE	DJ
01900		LDYI	0
02000	CKHOL:	LDAY	FBUF
02100		CMPI	FMARK	;Look for a hole.
02200		BNE	HOLE
02300		TYA
02400		CLC
02500		ADCI	20	;Next directory record.
02600		TAY
02700		BNE	CKHOL
02800	
02900		DECZ	SREM	;SREM ← SREM + 2.
03000		DECZ	SREM
03100		BNE	SQEZ
03200	PACKED:	JMP	ACK	;Done.
03300	DJ:	JMP	DIRERR	;Directory read error.
03600	
03700	;Hole found.
03800	HOLE:	LDAY	1013	;FBUF + TRK#
03900		STAZ	HTRK
04000		LDAY	1014	;FBUF + SEC#
04100		STAZ	HSEC
04120		STYZ	SVHY	;Save hole dir. index.
04140		LDAZ	CSEC
04160		STAZ	SVHSEC	;Save hole dir. sector.
04200	
04300	FINDF:	TYA	;Find next file.
04400		CLC
04500		ADCI	20	;Next dir. record.
04600		TAY
04700		BNE	CKFIL
04800		DECZ	SREM	;SREM ← SREM - 2.
04900		DECZ	SREM
05000		BEQ	PACKED	;Done.
05200		JSR	RNDS	;Read next directory sector.
05250		BNE	DJ	;Error.
05300		TAY	;Y ← 0.
05400	CKFIL:	LDAY	FBUF
05500		CMPI	FMARK
05600		BNE	FINDF
05700	   ;File found. Save file address.
05704		JSR	FMOV	;Save FBLK.
05744	
05800	;Fill hole.
05804	FILLIT:	LDAZ	FTRK	;Point to file.
05808		STAZ	CTRK
05812		LDAZ	FSEC
05816		STAZ	CSEC
05820		LDAI	123	;Read two sectors command.
05824		STAZ	CBLK
05828		JSR	RCMDW	;Read it.
05832		BNE	DJ
05836	
05840		LDAZ	HTRK	;Point to hole.
05844		STAZ	CTRK
05848		LDAZ	HSEC
05852		STAZ	CSEC
05856		CLC
05860		ADCI	2	;Next hole sectors.
05864		CMPI	=17
05868		BCC	WRIT
05872		INCZ	HTRK	;Next track.
05876		LDAI	1	;First sector.
05880	WRIT:	STAZ	HSEC
05884		JSR	WBUFW	;Fill hole.
05888		BNE	DJ	;?
05892	
05896		DECZ	NSEC	;NSEC ← NSEC - 2.
05900		DECZ	NSEC
05904		BEQ	CUPD	;Check if hole filled.
05908		LDAZ	FSEC
05912		CLC
05916		ADCI	2	;Next file sectors.
05920		CMPI	=17
05924		BCC	UPSEC
05928		INCZ	FTRK	;Next track.
05932		LDAI	1	;First sector.
05936	UPSEC:	STAZ	FSEC
05940		BNE	FILLIT	;Jump.
05944	
05948	CUPD:	LDAZ	SVHSEC	;Update directory.
05952		STAZ	CSEC	;Get hole dir. sector.
05956		LDAI	0	;Track zero.
05960		STAZ	CTRK
05964		JSR	RSEC	;Read hole dir. sector.
05968		BNE	DJ	;?
05972	
05976		LDXI	0
05978		LDYZ	SVHY	;Get hole dir. index.
05980	UPBLK:	LDAZX	FBLK	;FBUF ← FBLK - TRK&SEC
05984		STAY	FBUF
05988		INY
05992		INX
05996		CPXI	13	;FNAME + FMARK & NSEC.
06000		BCC	UPBLK
06025		JSR	WBUFW	;Write new dir.
06037		BNE	DJ	;?
06050	;Find next hole.
06100		JMP	CKHOL	;Jump to find file.
     

00100	GEOT:	JSR	GCHR	;Wait for EOT.
00200		CMPI	4	;<EOT>
00300		BNE	TERR
00400		LDAZ	CEFLG	;Checkk for comm. error.
00500		BNE	TERR
00600		RTS
00700	TERR:	PLA	;Fix stack?
00800		PLA
00900		JMP	ILLCMD	;?
01000	
01100	FORM:	JSR	GEOT
01200		JSR	MOTON	;Turn on motor.
01300		LDAI	RESTOR
01400		JSR	PCMD	;Seek track zero.
01500		JSR	SETDPO	;Point to FBUF.
01600		LDXI	6
01700	CSLOP:	LDAX	FORMT	;Setup command list.
01800		STAZX	CBLK
01900		DEX
02000		BPL	CSLOP
02100	
02200	TKOOP:	LDXI	1	;First sector.
02300		LDYI	0
02400	SCOOP:	LDAZ	FOTRK	;Get track number.
02500		STAY	FBUF	;And setup I.D.s.
02600		INY
02700		LDAI	0
02800		STAY	FBUF	;Head number.
02900		INY
03000		TXA
03100		STAY	FBUF	;Sector number.
03200		INY
03300		LDAI	0
03400		STAY	FBUF	;Length.
03500		INY
03600		INX	;Next sector.
03700		CPXI	=17	;Sectors per track +1.
03800		BCC	SCOOP
03900	
04000		JSR	WUF	;Write buffer.
04100	FW:	BITZ	BUSY	;Wait until not busy.
04200		BMI	FW
04300	   ;Add verify 16 sectors?
04400		INCZ	FOTRK	;Next track.
04500		LDAZ	FOTRK
04600		CMPI	=35
04700		BCC	TKOOP
04800	
04900		LDAZ	SVERR	;Check for errors.
05000		BNE	FERR
05100		JMP	ACK
05200	FERR:	JMP	DIRERR
     

00100	;Wait for input.
00200	GCHR:	LDA	SIOC	;Read SI/O status.
00300		LSRA	;Get rcvr. full bit.
00400		BCC	GCHR
00500		ANDI	30	;FE, OVR.
00600		BEQ	GOT1
00700		STAZ	CEFLG
00800	GOT1:	LDA	SIOD
00900		RTS
01000	
01100	PACK:	LDXI	6	;Output <ack>.
01200	;Output byte in X.
01300	OCHR:	LDA	SIOC	;Read SI/O status.
01400		ANDI	2	;Transmiter full bit.
01500		BEQ	OCHR
01600		STX	SIOD	;Output it.
01700		RTS
01800	PSTX:	LDXI	2	;Output <stx>.
01900		BNE	OCHR
02000	
02100	MOTOFF:	LDAI	MOFF	;Turn motor off.
02200		JSR	PCMD
02300		LDAI	0
02400		STAZ	MO	;Motor on flag.
02500		RTS
02600	
02700	   ONES ← 6	;6 = .98s, 7 = 1.15s.
02800	MOTON:	BITZ	MO	;Check if already on.
02900		BMI	SPIN
03000		LDAI	377	;Turn on motor.
03100		STAZ	TL	;Setup motor time out.
03200		LDAI	ONES
03300		STAZ	TH
03400		LDAI	MON	;Turn it on.
03500		JSR	PCMD
03600	
03700		LDXI	0	;Wait for motor on delay.
03800	MW:	DEX
03900		BNE	MW
04000		DECZ	TL
04100		BNE	MW
04200		DECZ	TH
04300		BNE	MW
04400	
04500		LDAI	377
04600		STAZ	MO	;Set motor on flag.
04700	SPIN:	LDAI	377	;Setup motor time out.
04800		STAZ	TL
04900		LDAI	TWOS
05000		STAZ	TH
05100		RTS
05200	
05300	;Reset and interrupt vectors.
05400	   LOC ZERO + 177772
050αX0		NMIV∧377	;NMI Vector.
05600		NMIV⊗-10
05700		RST∧377	;Reset vector.
05800		RST⊗-10
05900		IRQV∧377	;IRQ Vector.
06000		IRQV⊗-10
06100	END